home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / yerk / mps231ss.hqx / Mops source / Toolbox classes / interval timer < prev    next >
Text File  |  1993-02-01  |  1KB  |  49 lines
  1. \ interval  - interval timer stuff
  2. \ 12/14/84  cbd Version 1
  3. \ 10/15/85  cdn Fixed print: method in Timer
  4. \  1/31/87    rfl added clear:
  5. \  6/13/89    rfl added pause
  6.  
  7. \ ***Not converted to Mops yet.
  8.  
  9. Decimal
  10.  
  11. \ define an interval timer class
  12. :CLASS Timer  <Super Object
  13.  
  14.     Var        Ticks    \ store system ticks=60ths
  15.     Int        On        \ true = timing
  16.  
  17.     \ ( -- ticks ) update the system event record and return its time
  18.     :M  WHEN:  ?terminal drop  when: fEvent   ;M
  19.  
  20.     \ start timing an interval
  21.     :M  START:  when: self put: ticks  1 put: on  ;M
  22.  
  23.     \ stop the clock, and replace ticks with the interval
  24.     :M  STOP:   when: self get: ticks - put: ticks  clear: on ;M
  25.  
  26.     \ ( -- secs*60 ) get the current value of the clock, but keep timing if on
  27.     :M  GET:  get: on
  28.         IF  when: self  get: ticks -
  29.         ELSE  get: ticks  THEN  ;M
  30.  
  31.     \ print the current value of the timer, in seconds and hundredths
  32.     :M  PRINT:  get: self  60 /mod 3 .R  $ 2e emit  100 * 60 /
  33.         2 .R ."  Seconds " ;M
  34.  
  35.     :M  CLEAR: clear: on clear: ticks ;M
  36.  
  37. ;CLASS
  38.  
  39. Timer sysTimer    \ create an instance of Timer
  40.  
  41. \ ( -- f OR key t )  listen to event queue, true if key event
  42. : ?Key  next: fEvent  ;
  43.  
  44. \ general purpose pause where time is in 1/60ths of second
  45. timer pTimer
  46. : pause { time -- } start: pTimer
  47.     BEGIN next: fevent IF 2drop THEN get: pTimer time > UNTIL ;
  48.  
  49.